home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / link.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  16KB  |  540 lines
  1. {
  2.     $Id: link.pas,v 1.2.2.4 1998/08/31 12:19:29 peter Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit handles the linker and binder calls for programs and
  6.     libraries
  7.  
  8.     This program is free software; you can redistribute it and/or modify
  9.     it under the terms of the GNU General Public License as published by
  10.     the Free Software Foundation; either version 2 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     This program is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU General Public License
  19.     along with this program; if not, write to the Free Software
  20.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  ****************************************************************************
  23. }
  24. Unit link;
  25.  
  26. Interface
  27.  
  28. uses cobjects;
  29.  
  30. Type TLinker = Object
  31.      { Internal variables. Don't access directly }
  32.        {$ifdef linux}
  33.        LinkToC : Boolean;                 { Should we link to the C libs? }
  34.        GccLibraryPath : String;           { Where is GCCLIB ? }
  35.        DynamicLinker : String;            { What Dynamic linker ? }
  36.        {$endif}
  37.        OFiles, LibFiles : TStringContainer;
  38.        Strip : Boolean;                   { Strip symbols ? }
  39.        MakeLib : Boolean;                 { If unit : Make library ?}
  40.        ExeName,                           { FileName of the exe to be created }
  41.        LibName     : String;              { FileName of the lib to be created }
  42.        LinkResName : String[32];          { Name of response file }
  43.        LinkOptions : String;              { Additional options to the linker }
  44.        LibrarySearchPath : String;        { Where to look for libraries }
  45.      { Methods }
  46.        Constructor Init;
  47.        Procedure SetFileName(const s:string);
  48.        function  FindObjectFile(s : string) : string;
  49.        Procedure AddLibraryFile(S : String);
  50.        Procedure AddObjectFile(S : String);
  51.        Function  FindLinker : String;      { Find linker, sets Name }
  52.        Function  DoExec(const command,para:string):boolean;
  53.        Function  WriteResponseFile : Boolean;
  54.        Function  Link:boolean;
  55.        Procedure Make_Library;
  56.      end;
  57.      PLinker=^TLinker;
  58.  
  59. Var Linker : TLinker;
  60.  
  61.  
  62. Implementation
  63.  
  64. uses
  65.   Script,globals,systems,dos,verbose;
  66.  
  67. Constructor TLinker.Init;
  68. begin
  69.   OFiles.Init;
  70.   LibFiles.Init;
  71.   OFiles.Doubles:=False;
  72.   LibFiles.Doubles:=False;
  73.   Strip:=false;
  74.   LinkOptions:='';
  75.   LinkResName:='link.res';
  76.   ExeName:='';
  77.   LibName:='';
  78. {$ifdef linux}
  79.   LinkToC:=False;
  80.   LibrarySearchPath:='';
  81.   DynamicLinker:='/lib/ld-linux.so.1';
  82. {$endif}
  83. end;
  84.  
  85.  
  86. Procedure TLinker.SetFileName(const s:string);
  87. var
  88.   path:dirstr;
  89.   name:namestr;
  90.   ext:extstr;
  91. begin
  92.   FSplit(s,path,name,ext);
  93.   LibName:=Path+Name+target_info.DllExt;
  94.   ExeName:=Path+Name+target_info.ExeExt;
  95. end;
  96.  
  97.  
  98. var
  99.   LastLDBin : string;
  100. Function TLinker.FindLinker:string;
  101. var
  102.   ldfound : boolean;
  103. begin
  104.   if LastLDBin='' then
  105.    begin
  106.      if (target_info.target=target_WIN32) then
  107.      { the win32 linker has another name to allow cross compiling between }
  108.      { DOS and Win32, I think it should be possible to compile an ld      }
  109.      { with handles coff and pe, but I don't know how      (FK)           }
  110.        LastLDBin:=FindExe('ldw',ldfound)
  111.      else
  112.        LastLDBin:=FindExe('amigald',ldfound);
  113.      if (not ldfound) and (not externlink) then
  114.       begin
  115.         Message1(exec_w_linker_not_found,LastLDBin);
  116.         externlink:=true;
  117.       end;
  118.      if ldfound then
  119.       Message1(exec_u_using_linker,LastLDBin);
  120.    end;
  121.   FindLinker:=LastLDBin;
  122. end;
  123.  
  124.  
  125. { searches an object file }
  126. function TLinker.FindObjectFile(s:string) : string;
  127. var
  128.   found : boolean;
  129. begin
  130.   if pos('.',s)=0 then
  131.    s:=s+target_info.objext;
  132.   s:=FixFileName(s);
  133.   if FileExists(s) then
  134.    begin
  135.      Findobjectfile:=s;
  136.      exit;
  137.    end;
  138.   findobjectfile:=search(s,'.;'+unitsearchpath+';'+exepath,found)+s;
  139.   if (not externasm) and (not found) then
  140.    Message1(exec_e_objfile_not_found,s);
  141. end;
  142.  
  143.  
  144. Procedure TLInker.AddObjectFile (S : String);
  145. begin
  146.   if pos('.',s)=0 then
  147.    s:=s+target_info.objext;
  148.   s:=FixFileName(s);
  149.   OFiles.Insert (S);
  150. end;
  151.  
  152.  
  153. Procedure TLInker.AddLibraryFile(S:String);
  154. begin
  155.   if pos('.',s)=0 then
  156.    s:=s+target_info.dllext;
  157.   LibFiles.Insert (S);
  158. end;
  159.  
  160.  
  161. Function TLinker.DoExec(const command,para:string):boolean;
  162. begin
  163.   DoExec:=true;
  164.   if not externlink then
  165.    begin
  166.      swapvectors;
  167.      exec(command,para);
  168.      swapvectors;
  169.      if (dosexitcode<>0) then
  170.       begin
  171.         Message(exec_w_error_while_linking);
  172.         DoExec:=false;
  173.         exit;
  174.       end
  175.      else
  176.       if (dosError<>0) then
  177.        begin
  178.          Message(exec_w_cant_call_linker);
  179.          ExternLink:=true;
  180.        end;
  181.    end;
  182.   if externlink then
  183.    AsmRes.AddLinkCommand (Command,Para,ExeName);
  184. end;
  185.  
  186.  
  187. Function TLinker.WriteResponseFile : Boolean;
  188. Var
  189.   LinkResponse : Text;
  190.   i            : longint;
  191.   prtobj,s     : string;
  192. begin
  193. { Open linkresponse and write header }
  194.   assign(linkresponse,inputdir+LinkResName);
  195.   rewrite(linkresponse);
  196.  
  197. { Write Header and set runtime object (prt0) }
  198.   case target_info.target of
  199.    target_WIN32 : begin
  200.                     prtobj:='';
  201.                     writeln(linkresponse,'INPUT (');
  202.                   end;
  203.    target_PalmOS:
  204.      begin
  205.         prtobj:='';
  206.      end;
  207.    target_linux : begin
  208.                     if cs_profile in aktswitches then
  209.                      prtobj:='gprt0'
  210.                     else
  211.                      prtobj:='prt0';
  212. {$ifdef Linux}
  213.                     if LinkToC then
  214.                      writeln(linkresponse,'SEARCH_DIR ('+GCCLibraryPath +')');
  215. {$endif}
  216.                     writeln(linkresponse,'INPUT (');
  217.                   end;
  218.    target_AMIGA: begin
  219.                      prtobj:='prt0';
  220.                      writeln(linkresponse,'INPUT (');
  221.                  end;
  222.   else
  223.    prtobj:='prt0';
  224.   end;
  225.  
  226. { add objectfiles, start with prt0 always }
  227.   if prtobj<>'' then
  228.    Writeln(linkresponse,FindObjectFile(prtobj));
  229.   while not OFiles.Empty do
  230.    begin
  231.      s:=Findobjectfile(OFiles.Get);
  232.      if s<>'' then
  233.       Writeln(linkresponse,s);
  234.    end;
  235.  
  236. { Write libraries like -l<lib> }
  237.   While not LibFiles.Empty do
  238.    begin
  239.      S:=LibFiles.Get;
  240.      i:=Pos(target_info.dllext,S);
  241.      if i>0 then
  242.       Delete(S,i,255);
  243.      Writeln (LinkResponse,'-l'+S);
  244.    end;
  245.  
  246. { Write End of response file }
  247.   if target_info.target in [target_WIN32,target_linux,target_AMIGA] then
  248.     Writeln (LinkResponse,')');
  249.  
  250. { Close response }
  251.   close(linkresponse);
  252.   WriteResponseFile:=True;
  253. end;
  254.  
  255.  
  256. Function TLinker.link:boolean;
  257. var
  258.   bindbin    : string[80];
  259.   bindfound  : boolean;
  260.   _stacksize,i,
  261.   _heapsize  : longint;
  262.   s,s2       : string[10];
  263.   dummy      : file;
  264.   success    : boolean;
  265. begin
  266. {$ifdef linux}
  267.   if LinkToC then
  268.    begin
  269.      AddObjectFile('/usr/lib/crt0.o');
  270.      AddObjectFile(FindObjectFile('lprt'));
  271.      AddLibraryFile('libc.a');
  272.      AddLibraryFile('libgcc.a');
  273.    end;
  274. {$endif Linux}
  275.  
  276. { Create Linkoptions }
  277.   case target_info.target of
  278.      target_GO32V1:
  279.        LinkOptions:=LinkOptions+' -oformat coff-go32';
  280.      target_GO32V2:
  281.        LinkOptions:=LinkOptions+' -oformat coff-go32-exe';
  282.       target_linux: begin
  283.                       if cs_profile in aktswitches then
  284.                        begin
  285.                          AddLibraryFile('gmon');
  286.                          AddLibraryFile('c');
  287.                        end;     
  288.                     end;
  289.   end;
  290.  
  291. {$ifdef linux}
  292.   If not LibFiles.Empty then
  293.    LinkOptions:='-dynamic-linker='+DynamicLinker+' '+LinkOptions;
  294. {$endif linux}
  295.  
  296.   if Strip then
  297.    LinkOptions:=LinkOptions+' -s';
  298.  
  299. { Write used files and libraries }
  300.   WriteResponseFile;
  301.  
  302. { Call linker }
  303.   if not externlink then
  304.    Message1(exec_i_linking,ExeName);
  305. {$ifdef linux}
  306.   success:=DoExec(FindLinker,LinkOptions+' -o '+exename+' '+inputdir+LinkResName);
  307. {$else}
  308.   if target_info.target in [target_WIN32,target_AMIGA] then
  309.     success:=DoExec(FindLinker,LinkOptions+' -o '+exename+' '+inputdir+